home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / main.c < prev    next >
C/C++ Source or Header  |  1992-10-07  |  30KB  |  1,334 lines
  1. /* ******************************************************************** */
  2. /*  main.c           Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* User top level                                            */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * $Id: main.c,v 1.15 1992/03/13 18:08:06 pab Exp $
  9.  *
  10.  * $Log: main.c,v $
  11.  * Revision 1.15  1992/03/13  18:08:06  pab
  12.  * SysV fixes (interpreter thread sort out)
  13.  *
  14.  * Revision 1.14  1992/02/18  11:16:06  pab
  15.  * added handler
  16.  *
  17.  * Revision 1.13  1992/02/11  13:38:32  pab
  18.  * fixed generic version
  19.  *
  20.  * Revision 1.12  1992/02/11  12:06:05  pab
  21.  * handler around load of initcode
  22.  *
  23.  * Revision 1.11  1992/02/10  12:07:02  pab
  24.  * Bytecode support
  25.  *
  26.  * Revision 1.10  1992/01/29  13:42:12  pab
  27.  * sysV fixes
  28.  *
  29.  * Revision 1.9  1992/01/17  22:31:19  pab
  30.  * fixed to load initcode at startup
  31.  *
  32.  * Revision 1.7  1992/01/09  22:28:53  pab
  33.  * Fixed for low tag ints
  34.  *
  35.  * Revision 1.6  1991/12/22  15:14:18  pab
  36.  * Xmas revision
  37.  *
  38.  * Revision 1.5  1991/11/15  13:45:08  pab
  39.  * copyalloc rev 0.01
  40.  *
  41.  * Revision 1.4  1991/10/08  19:27:42  pab
  42.  * arg to init_elvira changed
  43.  *
  44.  * Revision 1.3  1991/09/22  19:14:37  pab
  45.  * Fixed obvious bugs
  46.  *
  47.  * Revision 1.2  1991/09/11  12:07:24  pab
  48.  * 11/9/91 First Alpha release of modified system
  49.  *
  50.  * Revision 1.1  1991/08/12  16:49:47  pab
  51.  * Initial revision
  52.  *
  53.  * Revision 1.18  1991/04/03  21:06:36  kjp
  54.  * -cons-cut-off option
  55.  *
  56.  * Revision 1.17  1991/04/03  16:28:06  kjp
  57.  * History modifications - incomplete
  58.  *
  59.  * Revision 1.16  1991/04/02  16:41:32  kjp
  60.  * Conses command line option.
  61.  *
  62.  * Revision 1.15  1991/02/28  14:00:52  kjp
  63.  * Command line stack-space option.
  64.  *
  65.  * Revision 1.14  1991/02/13  18:23:09  kjp
  66.  * Pass.
  67.  *
  68.  */
  69.  
  70. #define JMPDBG(x)
  71. #define CODBG(x) /* fprintf(stderr,"CODBG:");x;fflush(stderr) */
  72.  
  73. /*
  74.  * Change Log:
  75.  *   Version 1, April 1989
  76.  *     Read a .feelrc file if it exists - JPff
  77.  *    Various changes for streams
  78.  *    Remove Env argument from make_module_function and make_special 
  79.  *        as always NULL
  80.  *    Initialise threads.
  81.  *      Added a one result history and fiddled with some object definitions.
  82.  */
  83.  
  84. #include "version.h"
  85.  
  86. #include "defs.h"
  87. #include "structs.h"
  88. #include "funcalls.h"
  89.  
  90. #include "error.h"
  91. #include "global.h"
  92. #include "slots.h"
  93. /*#include "compact.h" */
  94. #include "garbage.h" /* What do I need this for */
  95.  
  96. #include "symboot.h"
  97. #include "modules.h"
  98. #include "toplevel.h"
  99. #include "root.h"
  100. #include "specials.h"
  101. #include "lists.h"
  102. #include "listops.h"
  103. #include "calls.h"
  104. #include "ccc.h"
  105. #include "allocate.h"
  106.  
  107. #include "modboot.h"
  108.  
  109. #include "state.h"
  110. #include "macros.h"
  111. #include "semaphores.h"
  112. #include "format.h"
  113. #include "modops.h"
  114.  
  115. #include "sio.h"
  116.  
  117. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  118. #include "sockets.h"
  119. #endif
  120.  
  121. #ifdef WITH_BYTECODE /* Bytecode interpreter stack */
  122. #include "bcstack.h"
  123. #endif
  124.  
  125. /*
  126.  * Hack number 1A - push everything as yet unmodulised into OTHER
  127.  */
  128.  
  129. #define OTHER_ENTRIES 24
  130. MODULE Module_others;
  131. LispObject Module_others_values[OTHER_ENTRIES];
  132.  
  133. /*
  134.  * The provided classes / constants / symbols
  135.  */
  136.  
  137. /* Built in constants */
  138.  
  139. LispObject nil;
  140. LispObject lisptrue;
  141. LispObject unbound;
  142.  
  143. /* Root class */
  144.  
  145. LispObject Object;
  146.  
  147. /* Meta classes */
  148.  
  149. LispObject  Standard_Class;
  150. LispObject   Slot_Description_Class;
  151.  
  152. LispObject Abstract_Class;
  153.  
  154. LispObject Slot_Description;
  155. LispObject  Local_Slot_Description;
  156.  
  157. LispObject Basic_Structure;
  158.  
  159. /* Allocation specifying metaclasses */
  160.  
  161. LispObject Structure_Class;                /* Analogous to C structs */
  162. LispObject Funcallable_Object_Class;       /* Function forms */
  163. LispObject Generic_Class;
  164. LispObject Pair_Class;
  165. LispObject Unpredictable_Fixed_Size_Class; /* Vector-type things */
  166. LispObject Variable_Size_Keyed_Class;      /* Tabular instances */
  167. LispObject Thread_Class;
  168. LispObject Method_Class;
  169.  
  170. /* Built in stuff */
  171.  
  172. LispObject Primitive_Class; 
  173.  
  174. /* The core building blocks */
  175.  
  176. LispObject Abstract_Class; /* Meta */
  177. LispObject Number, Complex, Real, Rational, Integer;
  178. LispObject Symbol, Character, String;
  179. LispObject Thread, Continue;
  180. LispObject Function, Generic, Method, Macro;
  181.  
  182. /* Composites */
  183.  
  184. LispObject Cons, Vector, Table, Null; /* Empty list... */
  185.  
  186. /* Special pointer */
  187.  
  188. LispObject Weak_Wrapper;
  189.  
  190. /* Flag thing */
  191.  
  192. LispObject last_evaluated_expression;         /* Input help */
  193. LispObject top_level(LispObject*);
  194. extern FILE* current_output;
  195.  
  196. /* Quick way of making self evaluating sybols */
  197.  
  198. void make_special_symbol(LispObject *stacktop, LispObject *objptr, char *name )
  199. {
  200.   *objptr = (LispObject) get_symbol(stacktop, name );
  201.   lval_typeof(*objptr) = TYPE_SYMBOL;
  202.   gcof((*objptr))   = 0;
  203.   ((*objptr)->SYMBOL).right = NULL;
  204. }
  205.  
  206. /* Map maker... */
  207.  
  208. void make_map(LispObject *stacktop)
  209. {
  210.   extern LispObject global_module_table;
  211.   extern LispObject Fn_table_parameters(LispObject*);
  212.  
  213.   LispObject mods;
  214.   FILE *byfun;
  215.   FILE *bymod;
  216.  
  217.   byfun = fopen("/opt/home/kjp/You/Maps/funmap.map","w");
  218.   bymod = fopen("/opt/home/kjp/You/Maps/modmap.map","w");
  219.  
  220.   EUCALLSET_1(mods, Fn_table_parameters, global_module_table);
  221.  
  222.   while (is_cons(mods)) {
  223.     LispObject mod;
  224.     LispObject exp;
  225.  
  226.     mod = CAR(mods); mods = CDR(mods);
  227.  
  228.     if (is_c_module(mod)) {
  229.  
  230.       fprintf(bymod,"Compiled module '%s' exports:\n\n",
  231.           mod->C_MODULE.name->SYMBOL.pname);
  232.  
  233.     }
  234.     else {
  235.  
  236.       fprintf(bymod,"Interpreted module '%s' exports:\n\n",
  237.           mod->I_MODULE.name->SYMBOL.pname);
  238.  
  239.     }
  240.  
  241.     exp = mod->I_MODULE.exported_names;
  242.  
  243.     while (is_cons(exp)) {
  244.       LispObject name;
  245.  
  246.       name = CAR(exp); exp = CDR(exp);
  247.  
  248.       fprintf(bymod,"\t\t\t\t\t%s\n ",name->SYMBOL.pname);
  249.  
  250.       fprintf(byfun,"%-40s%s\n",
  251.           name->SYMBOL.pname,mod->I_MODULE.name->SYMBOL.pname);
  252.  
  253.     }
  254.  
  255.     fprintf(bymod,"\n");
  256.  
  257.   }
  258.  
  259.   fclose(bymod);
  260.   fclose(byfun);
  261.  
  262. }
  263.  
  264. /* Top level thread holder... */
  265.  
  266. LispObject interpreter_thread;
  267.  
  268. /* Temporary-ish jump buffer... */
  269.  
  270. LispObject tl_thread;
  271.  
  272. jmp_buf temp_buffer;
  273.  
  274. extern LispObject read_eval_print_continue;
  275. LispObject boot_thread;
  276.  
  277. int main(int argc, char ** argv)
  278. {
  279.   void load_and_boot(LispObject *);
  280.   extern void runtime_initialise_allocator(LispObject*);
  281.   void configure(int,char **);
  282.   void start_interpreter(LispObject*);
  283.  
  284.   LispObject *gc_local_stack;
  285.  
  286.   configure(argc,argv);
  287.  
  288.   /*
  289.  
  290.    * System initialisation...
  291.  
  292.    */
  293.  
  294.   runtime_initialise_system();     /* Rig system spec stuff */
  295.   runtime_initialise_allocator(NULL);  
  296.   runtime_initialise_garbage_collector(NULL);
  297.  
  298. #ifdef WITH_BYTECODE
  299. /* Initialize bytecode interpreter stack */
  300.  
  301.   init_stack();
  302. #endif
  303.  
  304.   OFF_collect();
  305.  
  306.   /*
  307.  
  308.    * We gotta rig up something so that we can use a few basic system
  309.    * functions during the main bootstrap sequence - this implies
  310.    * just setting up what will become the interpreter thread enough
  311.    * to get us moving...
  312.  
  313.    */
  314.  
  315.   /*
  316.  
  317.    * Set up preliminary thread stuff...
  318.  
  319.    */
  320.  
  321.   /* Interpreter GC stack (nominal, for bootstrapping)... */
  322.  
  323.   gc_local_stack = (LispObject*) malloc(4096*sizeof(LispObject*));
  324.   if (gc_local_stack ==  NULL) {
  325.     fprintf(stderr,"Really nasty error: unable to malloc gc_local_stack\n");
  326.     exit(1);
  327.   }
  328.  
  329.   fprintf(stderr,"stack: 0x%x Lim: 0x%x\n",
  330.       gc_local_stack,
  331.       gc_local_stack + 4096);
  332.   /* Allocate the top level thread... */
  333.  
  334.   nil = NULL;
  335.   Thread = NULL;
  336.  
  337.   boot_thread 
  338.     = allocate_thread(gc_local_stack,0,0,0);
  339.  
  340.   /* Fill in as best we can... */
  341.  
  342.   boot_thread->THREAD.stack_base = NULL;
  343.   boot_thread->THREAD.gc_stack_base = gc_local_stack;
  344.   boot_thread->THREAD.state->CONTINUE.gc_stack_pointer = gc_local_stack;
  345.  
  346.   boot_thread->THREAD.stack_base = NULL;
  347.   boot_thread->THREAD.gc_stack_base = gc_local_stack;
  348.  
  349.   boot_thread->THREAD.stack_size = 0xffffffff; /* lots'n'lots */
  350.   boot_thread->THREAD.gc_stack_size = 100*HUNK_PAGE_SIZE()*sizeof(LispObject*);
  351.  
  352.   boot_thread->THREAD.fun = nil;
  353.   boot_thread->THREAD.args = nil;
  354.   boot_thread->THREAD.value = nil;
  355.   
  356.   boot_thread->THREAD.status = NULL;
  357.  
  358.   boot_thread->THREAD.parent = nil;
  359.   boot_thread->THREAD.cochain = nil;
  360.  
  361.   /* Thread continuation... */
  362.  
  363.   boot_thread->THREAD.state->CONTINUE.thread = boot_thread;
  364.  
  365.   boot_thread->THREAD.state->CONTINUE.value = nil;
  366.   boot_thread->THREAD.state->CONTINUE.target = nil;
  367.  
  368. /*  boot_thread->THREAD.state.machine_state; */
  369.   boot_thread->THREAD.state->CONTINUE.gc_stack_pointer = gc_local_stack;
  370.   boot_thread->THREAD.state->CONTINUE.dynamic_env = NULL;
  371.   boot_thread->THREAD.state->CONTINUE.last_continue = nil;
  372.   boot_thread->THREAD.state->CONTINUE.handler_stack = nil;
  373.  
  374.   boot_thread->THREAD.state->CONTINUE.live = FALSE;
  375.   boot_thread->THREAD.state->CONTINUE.unwind = FALSE;
  376.  
  377.   /*
  378.  
  379.    * We have a 'serviceable' thread - initialise the system specific
  380.    * bits for serial initialisation...
  381.  
  382.    */
  383.   { 
  384.     LispObject *stacktop;
  385.     
  386.     stacktop = load_thread(boot_thread); /* Context to this thread... */
  387.     add_root(&boot_thread);
  388.     load_and_boot(stacktop);          /* Do module boot sequence... */
  389.     
  390.     interpreter_thread=EUCALL_2(Fn_cons,nil,nil);
  391.     read_eval_print_continue=EUCALL_2(Fn_cons,nil,nil);
  392.     tl_thread=EUCALL_2(Fn_cons,nil,nil);
  393.  
  394.     add_root(&interpreter_thread);
  395.     add_root(&read_eval_print_continue);
  396.     add_root(&tl_thread);
  397.  
  398.     start_interpreter(stacktop);      /* Start the interpreter... */
  399.   }
  400. }
  401.  
  402. #define INTERPRETER_THREAD_STACK_SIZE  (64*1024*1)
  403. #define INTERPRETER_THREAD_GC_STACK_SIZE  (32*1024*1)
  404.  
  405.  
  406. #ifndef MACHINE_ANY
  407.  
  408. void start_interpreter(LispObject *stacktop)
  409. {
  410.   extern LispObject Fn_thread_start(LispObject*);
  411.   void start_history(void);
  412.  
  413.   LispObject function_read_eval_print;
  414.  
  415.   CAR(interpreter_thread) 
  416.     = allocate_thread(stacktop, INTERPRETER_THREAD_STACK_SIZE,
  417.               INTERPRETER_THREAD_GC_STACK_SIZE,0);
  418.  
  419.   function_read_eval_print =
  420.     allocate_module_function(stacktop, nil,nil,top_level,0);
  421.  
  422.   CAR(interpreter_thread)->THREAD.fun = function_read_eval_print;
  423.   CAR(interpreter_thread)->THREAD.status = THREAD_LIMBO;
  424.   system_thread_rig(stacktop,CAR(interpreter_thread));
  425.  
  426.   /* Install as ready... */
  427.  
  428.   EUCALL_2(Fn_thread_start,CAR(interpreter_thread),nil);
  429.  
  430.   CAR(read_eval_print_continue) = allocate_continue(stacktop);
  431. #ifndef KJP
  432.   start_history();
  433. #endif
  434.  
  435.   /* Store as the top level thread... */
  436.   
  437.   tl_thread = CAR(interpreter_thread);
  438.  
  439.   /* Name and configuration... */
  440.  
  441.   printf("EuLISP FEEL: Version (%d.%.02d ",MAJOR_VERSION,MINOR_VERSION);
  442.  
  443. #ifdef KJP
  444.  
  445. #ifdef MACHINE_SYSTEMV
  446.   printf("KJP-SystemV)");
  447. #endif
  448. #ifdef MACHINE_BSD
  449.   printf("KJP-BSD)");
  450. #endif
  451. #ifdef MACHINE_ANY
  452.   printf("KJP-Generic)");
  453. #endif
  454. #ifdef FIX_LEVEL
  455.   printf(" (fix %d)",FIX_LEVEL);
  456. #endif
  457.  
  458. #else /* KJP */
  459.  
  460. #ifdef MACHINE_SYSTEMV
  461.   printf("SystemV)");
  462. #endif
  463. #ifdef MACHINE_BSD
  464.   printf("BSD)");
  465. #endif
  466. #ifdef MACHINE_ANY
  467.   printf("Generic)");
  468. #endif
  469. #ifdef FIX_LEVEL
  470.   printf(" (fix %d)",FIX_LEVEL);
  471. #endif
  472.  
  473. #endif /* KJP */
  474.  
  475.   printf(" %s\n",MAKE_DATE);
  476.   printf("\n");
  477.  
  478. #ifdef VERSION_MESSAGE
  479.   printf("                    Version Message\n\n");
  480.   printf(VERSION_MESSAGE);
  481.   printf("\n");
  482. #endif
  483.  
  484.   fflush(stdout);
  485.   ON_collect();
  486.   
  487.   {LispObject xx;
  488.  
  489.    xx=boot_thread;
  490.    boot_thread=nil;
  491.    runtime_begin_processes(xx->THREAD.state->CONTINUE.gc_stack_pointer);
  492.  }
  493. }
  494.  
  495. #else
  496.  
  497. void start_interpreter(LispObject *stacktop)
  498. {
  499.   void start_history(void);
  500.  
  501.   /* Generate the interpreter thread... */
  502.  
  503.   CAR(interpreter_thread )
  504.     = allocate_thread(stacktop, 0,INTERPRETER_THREAD_GC_STACK_SIZE,0);
  505.   CAR(interpreter_thread)->THREAD.fun = nil;
  506.   CAR(interpreter_thread)->THREAD.status = THREAD_RUNNING;
  507.  
  508.   CAR(read_eval_print_continue) = allocate_continue(stacktop);
  509.  
  510. #ifndef KJP
  511.   start_history();
  512. #endif
  513.  
  514.   /* Store as the top level thread... */
  515.  
  516.   CAR(tl_thread) = CAR(interpreter_thread);
  517.   /* Name and configuration... */
  518.   ON_collect();
  519.  
  520.   printf("EuLISP FEEL: Version (%d.%.02d ",MAJOR_VERSION,MINOR_VERSION);
  521.  
  522. #ifdef KJP
  523.  
  524. #ifdef MACHINE_SYSTEMV
  525.   printf("KJP-SystemV)");
  526. #endif
  527. #ifdef MACHINE_BSD
  528.   printf("KJP-BSD)");
  529. #endif
  530. #ifdef MACHINE_ANY
  531.   printf("KJP-Generic)");
  532. #endif
  533. #ifdef FIX_LEVEL
  534.   printf(" (fix %d)",FIX_LEVEL);
  535. #endif
  536.  
  537. #else /* KJP */
  538.  
  539. #ifdef MACHINE_SYSTEMV
  540.   printf("SystemV)");
  541. #endif
  542. #ifdef MACHINE_BSD
  543.   printf("BSD)");
  544. #endif
  545. #ifdef MACHINE_ANY
  546.   printf("Generic)");
  547. #endif
  548. #ifdef FIX_LEVEL
  549.   printf(" (fix %d)",FIX_LEVEL);
  550. #endif
  551.  
  552. #endif /* KJP */
  553.  
  554.   printf(" %s\n",MAKE_DATE);
  555.   printf("\n");
  556.  
  557. #ifdef VERSION_MESSAGE
  558.   printf("                    Version Message\n\n");
  559.   printf(VERSION_MESSAGE);
  560.   printf("\n");
  561. #endif
  562.  
  563.   fflush(stdout);
  564.  
  565.   stacktop = load_thread(CAR(tl_thread)); /* So repl continue has the right thread base */
  566.   ON_collect();
  567.   (void) top_level(stacktop);
  568. }
  569.  
  570. #endif
  571.  
  572. void load_and_boot(LispObject *stacktop)
  573. {
  574.   extern MODULE Module_generics;
  575.   extern int gc_enabled;
  576.   extern void initialise_elvira_modules(LispObject *);
  577.  
  578.   bootstrap(stacktop); /* Bootstrap classes and some special symbols */
  579.   initialise_modules(stacktop);
  580.   initialise_symbols(stacktop); /* Rig up the others */
  581.   initialise_specials(stacktop);
  582.   initialise_root(stacktop);
  583.  
  584.   /* Hacked history */
  585.  
  586.   make_special_symbol(stacktop, &last_evaluated_expression, ":last" );
  587.  
  588.   /* Open up the other module and do the rest */
  589.  
  590.   open_module(stacktop,
  591.           &Module_others,Module_others_values,"others",OTHER_ENTRIES);
  592.  
  593.   initialise_set(stacktop);
  594.   initialise_basic(stacktop);
  595.   initialise_garbage(stacktop);
  596.   initialise_macros(stacktop);
  597.  
  598.   close_module();    
  599.   lval_typeof((LispObject)&Module_generics)=TYPE_C_MODULE;
  600.   
  601.   /* Initialise the modular sections */
  602.  
  603.   initialise_error(stacktop);
  604.   initialise_classes(stacktop);
  605.   initialise_streams(stacktop);
  606.   initialise_generics(stacktop);
  607.   initialise_ccc(stacktop);
  608.   initialise_lists(stacktop);
  609.   initialise_listops(stacktop);
  610.   initialise_tables(stacktop);
  611.   initialise_vectors(stacktop);
  612.   initialise_chars(stacktop);
  613.   initialise_calls(stacktop);
  614.   initialise_arith(stacktop);
  615.   initialise_threads(stacktop);
  616.   initialise_semaphores(stacktop);
  617. /*
  618.   INIT_plural(stacktop);
  619. */
  620.  
  621.   initialise_formatted_io(stacktop);
  622.   initialise_module_operators(stacktop);
  623.   INIT_plural(stacktop);
  624.  
  625. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  626.   {
  627.     extern void initialise_sockets(void);
  628.     initialise_sockets();
  629.   }
  630. #endif
  631.   initialise_bit_vectors(stacktop);
  632.  
  633. #ifdef WITH_BIGNUMS
  634.   initialise_bignums(stacktop);
  635. #endif
  636.  
  637. #ifdef BCI
  638.   initialise_bci(stacktop);
  639. #endif
  640.   /* Set up Elvira modules... */
  641.  
  642.   /* Note: because these may contain init-errors, we provide a handler */
  643.  
  644.   {
  645.     extern LispObject function_bootstrap_handler;
  646.     LispObject xx;
  647.  
  648.     EUCALLSET_2(xx,Fn_cons,function_bootstrap_handler,nil);
  649.     HANDLER_STACK() =
  650.       CURRENT_THREAD()->THREAD.state->CONTINUE.handler_stack 
  651.     = xx;
  652.   }
  653.  
  654.   initialise_elvira_modules(stacktop);
  655. }
  656.  
  657. LispObject read_eval_print_continue;
  658.  
  659. /* This top-level is the function which is run on the interpreter thread... */
  660.  
  661. int command_line_do_done_flag;
  662. int feelrc_read_flag;
  663.  
  664. LispObject top_level(LispObject *stacktop)
  665. {
  666.   extern char *command_line_do_string;
  667.   extern int command_line_map_flag;
  668.   LispObject get_history_form(LispObject);
  669.   void put_history_form(LispObject *,LispObject);
  670.   int get_history_count(void);
  671.   void initialise_input_processing(void);
  672.   LispObject process_input_form(LispObject);
  673.   LispObject process_result_form(LispObject);
  674.  
  675.   if (command_line_map_flag) make_map(stacktop);
  676.  
  677.   CODBG(fprintf(stderr,"Entering toplevel on thread %d\n",THIS_PROCESS));
  678.  
  679.   current_output = (StdOut->STREAM).handle;
  680.   SYSTEM_GLOBAL_VALUE(current_interactive_module) =
  681.     get_module(stacktop,sym_root);
  682.  
  683.   command_line_do_done_flag = FALSE;
  684.   feelrc_read_flag = FALSE;
  685.  
  686. #ifdef KJP
  687.   initialise_input_processing();
  688. #endif
  689.  
  690.   /* Load the initialisation module */
  691.   {
  692.     LispObject sym_init;
  693.     extern LispObject function_bootstrap_handler;
  694.     extern LispObject function_default_handler;
  695.     LispObject xx,oldstack;
  696.  
  697.     sym_init=get_symbol(stacktop,"initcode");
  698.  
  699.     EUCALLSET_2(xx,Fn_cons,function_bootstrap_handler,nil);
  700.     HANDLER_STACK() = xx;
  701.  
  702.     EUCALL_1(load_module,sym_init);
  703.     HANDLER_STACK()=CDR(xx);
  704.  
  705.     EUCALLSET_2(xx,Fn_cons,function_default_handler,nil);
  706.     HANDLER_STACK() = xx;
  707.   }
  708.  
  709.  
  710.  reset:
  711.  
  712.   if (set_continue(stacktop,CAR(read_eval_print_continue))) {
  713.  
  714.     if (CAR(read_eval_print_continue)->CONTINUE.value == lisptrue) {
  715.       (void) garbage_collect(stacktop);
  716.       printf("\n");
  717.       fflush(stdout);
  718.     }
  719.  
  720. #ifdef KJP
  721.  
  722.     /* Being here implies that no result was returned from the last 
  723.        expression so we'll add a dummy value to the value history   */
  724.  
  725.  
  726.     (void) process_result_form(nil);
  727. #endif
  728.  
  729.     /* Doc Frankenstein would be proud... */
  730.  
  731.     goto reset;
  732.  
  733.   }
  734.  
  735.   /* If do was configured, fix it... */
  736.  
  737.   if (command_line_do_string != NULL && command_line_do_done_flag == FALSE) {
  738.     LispObject command,ans;
  739.     
  740.     command_line_do_done_flag = TRUE;
  741.  
  742.     BUFFER_PTR() = 0;
  743.     strcpy(BUFFER_START(),command_line_do_string);
  744.  
  745.     fprintf(StdOut->STREAM.handle,"Doing: '%s'\n",BUFFER_START());
  746.  
  747.     command = read_object(stacktop);
  748.  
  749.     fprintf(StdOut->STREAM.handle,"Exp: ");
  750.     EUCALL_2(Fn_print,command,StdOut);
  751.  
  752.     EUCALLSET_2(ans,process_top_level_form,
  753.          SYSTEM_GLOBAL_VALUE(current_interactive_module),
  754.          command);
  755.  
  756.     fprintf(StdOut->STREAM.handle,"Done: ");
  757.     EUCALL_2(Fn_print,ans,StdOut);
  758.     fprintf(StdOut->STREAM.handle,"\n");
  759.   }
  760.  
  761.   /* Load the configuration file... */
  762.  
  763.   if (!feelrc_read_flag) {
  764.     extern char *getenv(char *);
  765.     extern LispObject Fn_close(LispObject*);
  766.     char path[1000];
  767.     FILE *inits;
  768.     LispObject initstr;
  769.     char *home;
  770.  
  771.     feelrc_read_flag = TRUE;
  772.  
  773.     home = getenv("HOME");
  774.     if (home == NULL) path[0] = '\0';
  775.     strcpy(path,home);
  776.     strcat(path,"/.feelrc");
  777.     inits = fopen(path,"r");
  778.     if (inits != NULL) {
  779.  
  780.       initstr = allocate_stream(stacktop, inits,'r');
  781.       while (TRUE) {
  782.     LispObject form;
  783.     STACK_TMP(initstr);
  784.     EUCALLSET_1(form, Fn_read, initstr);
  785.     UNSTACK_TMP(initstr);
  786.     if (form == q_eof) break;
  787.     STACK_TMP(initstr);
  788.     EUCALL_2(process_top_level_form,
  789.              SYSTEM_GLOBAL_VALUE(current_interactive_module),
  790.              form);
  791.     UNSTACK_TMP(initstr);
  792.       }
  793.       EUCALL_1(Fn_close, initstr);
  794.     }
  795.   }
  796.  
  797.   while (TRUE) {
  798.     extern char current_prompt_string[];
  799.     extern LispObject Gf_generic_write(LispObject*);
  800.     extern LispObject sym_pling_root;
  801.     extern LispObject sym_pling_exit;
  802.     extern int system_scheduler_number;
  803.     LispObject form, ans;
  804.     FILE *current_output;
  805.  
  806.     current_output = (StdOut->STREAM).handle;
  807.  
  808.     sprintf(current_prompt_string,"eulisp:%x:%s!%d> ",system_scheduler_number,
  809.         SYSTEM_GLOBAL_VALUE(current_interactive_module)
  810.           ->I_MODULE.name->SYMBOL.pname,
  811.         get_history_count());
  812.  
  813. #ifndef GNUREADLINE
  814.     fprintf(current_output,"%s",current_prompt_string);
  815.     fflush(current_output);
  816. #endif
  817.     EUCALLSET_1(form, Fn_read, nil);
  818. #ifdef KJP
  819.     if ((form = process_input_form(form)) == NULL) break;
  820.     ans 
  821.       = process_top_level_form(SYSTEM_GLOBAL_VALUE(current_interactive_module),
  822.                    form);
  823.     ans = process_result_form(ans);
  824. #else
  825.     form = get_history_form(form); /* never allocs */
  826.     STACK_TMP(form);
  827.     put_history_form(stacktop, form);
  828.     UNSTACK_TMP(form);
  829.     if (form == q_eof || form == sym_pling_exit) break;
  830.     if (form == sym_pling_root) {
  831.       SYSTEM_GLOBAL_VALUE(current_interactive_module) =
  832.     get_module(stacktop,sym_root);
  833.       ans = nil;
  834.     }
  835.     else {
  836.       EUCALLSET_2(ans,process_top_level_form,
  837.           SYSTEM_GLOBAL_VALUE(current_interactive_module),
  838.           form);
  839.  
  840.       last_evaluated_expression = ans;
  841.     }
  842. #endif
  843.  
  844.     current_output = (StdOut->STREAM).handle;
  845.  
  846.     if (GC_STACK_POINTER() != GC_STACK_BASE())
  847.       fprintf(current_output,"GC Error: ptr=%d (recovered)\n",
  848.           GC_STACK_POINTER() - GC_STACK_BASE());
  849.     /** hack **/
  850.     GC_STACK_POINTER() = GC_STACK_BASE();
  851.  
  852.     fprintf(current_output,"eulisp:%x:%s!%d< ",system_scheduler_number,
  853.         SYSTEM_GLOBAL_VALUE(current_interactive_module)
  854.           ->I_MODULE.name->SYMBOL.pname,
  855.         get_history_count()-1);
  856.  
  857.     EUCALL_2(Gf_generic_write,ans,StdOut);
  858.  
  859.     fprintf(current_output,"\n\n");
  860.     fflush(current_output);
  861.  
  862.   }
  863.  
  864.   fprintf(stderr,"\nEuLISP finishing\n\n");
  865.  
  866.   system_lisp_exit(1);
  867.  
  868.   return nil;
  869.  
  870. }
  871.  
  872. /* 
  873.  
  874.  * Configuration... 
  875.  
  876.  */
  877.  
  878. char *command_line_do_string;
  879. int command_line_window_flag;
  880. int command_line_heap_size;
  881. int command_line_stack_space_size;
  882. int command_line_map_flag;
  883. int command_line_processors;
  884. int command_line_interface_flag;
  885. int command_line_cons_percentage;
  886. int command_line_cons_cut_off;
  887.  
  888. void configure(int argc,char **argv)
  889. {
  890.   extern int command_line_x_debug;
  891.   int i = 1;
  892.  
  893.   /* Nullify options... */
  894.  
  895.   command_line_do_string = NULL;
  896.   command_line_window_flag = FALSE;
  897.   command_line_heap_size = 0;
  898.   command_line_stack_space_size = 0;
  899.   command_line_map_flag = FALSE;
  900.   command_line_x_debug = FALSE;
  901.   command_line_interface_flag = FALSE;
  902.   command_line_processors = 0;
  903.   command_line_cons_percentage = 0;
  904.   command_line_cons_cut_off = 0;
  905.  
  906.   while (i < argc) {
  907.  
  908.     if (strcmp(argv[i],"-do") == 0) {
  909.       if (argc - i < 2) {
  910.     fprintf(stderr,"eulisp: bad -do option\n");
  911.     exit(1);
  912.       }
  913.       command_line_do_string = argv[i+1];
  914.       i+=2;
  915.       continue;
  916.     }
  917.  
  918.     if (strcmp(argv[i],"-win") == 0) {
  919.       command_line_window_flag = TRUE;
  920.       ++i;
  921.       continue;
  922.     }
  923.  
  924.     if (strcmp(argv[i],"-xdebug") == 0 
  925.     || strcmp(argv[i],"-Xdebug") == 0) {
  926.       command_line_x_debug = TRUE;
  927.       ++i;
  928.       continue;
  929.     }
  930.  
  931.     if (strcmp(argv[i],"-heap") == 0) {
  932.       if (argc - i < 2) {
  933.     fprintf(stderr,"eulisp: bad -heap option\n");
  934.     exit(1);
  935.       }
  936.       sscanf(argv[i+1],"%d",&command_line_heap_size);
  937.       i+=2;
  938.       continue;
  939.     }
  940.  
  941.     if (strcmp(argv[i],"-stack-space") == 0) {
  942.       if (argc - i < 2) {
  943.     fprintf(stderr,"eulisp: bad -stack-space option\n");
  944.     exit(1);
  945.       }
  946.       sscanf(argv[i+1],"%d",&command_line_stack_space_size);
  947.       i+=2;
  948.       continue;
  949.     }
  950.  
  951.     if (strcmp(argv[i],"-conses") == 0) {
  952.       if (argc - i < 2) {
  953.     fprintf(stderr,"eulisp: bad -conses option\n");
  954.     exit(1);
  955.       }
  956.       sscanf(argv[i+1],"%d",&command_line_cons_percentage);
  957.       i+=2;
  958.       continue;
  959.     }
  960.  
  961.     if (strcmp(argv[i],"-cons-cut-off") == 0) {
  962.       if (argc - i < 2) {
  963.     fprintf(stderr,"eulisp: bad -cons-cut-off option\n");
  964.     exit(1);
  965.       }
  966.       sscanf(argv[i+1],"%d",&command_line_cons_cut_off);
  967.       i+=2;
  968.       continue;
  969.     }
  970.  
  971.     if (strcmp(argv[i],"-procs") == 0) {
  972.       if (argc - i < 2) {
  973.     fprintf(stderr,"eulisp: bad -procs option\n");
  974.     exit(1);
  975.       }
  976.       sscanf(argv[i+1],"%d",&command_line_processors);
  977.       if (command_line_processors < 1) {
  978.     fprintf(stderr,"eulisp: bad -procs value\n");
  979.     exit(1);
  980.       }
  981.       if (command_line_processors > MAX_PROCESSORS) {
  982.     fprintf(stderr,"eulisp: -procs value higher than %d maximum\n",
  983.         MAX_PROCESSORS);
  984.     exit(1);
  985.       }
  986.       i+=2;
  987.       continue;
  988.     }
  989.  
  990.     if (strcmp(argv[i],"-map") == 0) {
  991.       command_line_map_flag = TRUE;
  992.       ++i;
  993.       continue;
  994.     }
  995.  
  996.     if (strcmp(argv[i],"-gen-interfaces") == 0) {
  997.       command_line_interface_flag = TRUE;
  998.       ++i;
  999.       continue;
  1000.     }
  1001.  
  1002.     fprintf(stderr,"eulisp: unknown option '%s'\n",argv[i]);
  1003.     exit(1);
  1004.  
  1005.   }
  1006.  
  1007.   /* From environment */
  1008. }
  1009.  
  1010. #ifdef KJP
  1011.  
  1012. /*
  1013.  ** Hacked histories...
  1014.  **
  1015.  **   One to redo commands and one for values.
  1016.  */
  1017.  
  1018. typedef struct history_structure {
  1019.   LispObject value_list;
  1020.   int        count;
  1021. } History;
  1022.  
  1023. /* Abstract operations */
  1024.  
  1025. static void initialise_history(History *h)
  1026. {
  1027.   h->value_list = nil;
  1028.   h->count = 0;
  1029. }
  1030.  
  1031. static void add_history_value(History *h,LispObject value)
  1032. {
  1033.   extern LispObject Fn_nconc(LispObject*);
  1034.  
  1035.   ++(h->count);
  1036.   EUCALLSET_2(value, Fn_cons, value, nil);
  1037.   EUCALLSET_2(h->value_list, Fn_nconc, h->value_list,value);
  1038. }
  1039.  
  1040. static LispObject get_history_value(History *h,int n)
  1041. {
  1042.   LispObject walker;
  1043.   int i;
  1044.  
  1045.   if (n > h->count) return(NULL);
  1046.  
  1047.   for (walker = h->value_list, i = 0; i < n; ++i, walker = CDR(walker));
  1048.  
  1049.   return(CAR(walker));
  1050. }
  1051.  
  1052. static void show_history(History *h)
  1053. {
  1054.   int i;
  1055.   LispObject walker;
  1056.  
  1057.   EUDECL(Gf_generic_write);
  1058.  
  1059.   for (i = 0, walker = h->value_list;
  1060.          is_cons(walker); 
  1061.            ++i, walker = CDR(walker)) {
  1062.  
  1063.     printf("%d: ",i);
  1064.     (void) EUCALL_2(Gf_generic_write,CAR(walker),StdOut);
  1065.     printf("\n");
  1066.     fflush(stdout);
  1067.  
  1068.   }
  1069.  
  1070. }
  1071.  
  1072. /* Our histories... */
  1073.  
  1074. /* Input history */
  1075.  
  1076. static SYSTEM_GLOBAL(History *,input_history);
  1077.  
  1078. /* Value history */
  1079.  
  1080. static SYSTEM_GLOBAL(History *,value_history);
  1081.  
  1082. static int history_index(History *h,LispObject sym,char *prefix)
  1083. {
  1084.   int len,index,i;
  1085.  
  1086.   len = strlen(prefix);
  1087.  
  1088.   /* Too short or not right? */
  1089.  
  1090.   if (strlen(sym->SYMBOL.pname) < len) return(-1);
  1091.   if (strncmp(sym->SYMBOL.pname,prefix,len) != 0) return(-1);
  1092.  
  1093.   /* Exactly right? */
  1094.  
  1095.   if (strlen(sym->SYMBOL.pname) == len) return(h->count-1);
  1096.  
  1097.   /* All digits */
  1098.  
  1099.   for (i = len; sym->SYMBOL.pname[i] != '\0'; ++i)
  1100.     if (!isdigit(sym->SYMBOL.pname[i])) return(-1);
  1101.  
  1102.   /* Get the number */
  1103.  
  1104.   sscanf(&(sym->SYMBOL.pname[len]),"%d",&index);
  1105.  
  1106.   /* OK? */
  1107.  
  1108.   if (index >= h->count || index < 0) return(-1);
  1109.  
  1110.   return(index);
  1111.  
  1112. }
  1113.  
  1114. void add_input_history_value(LispObject form)
  1115. {
  1116.   add_history_value(SYSTEM_GLOBAL_VALUE(input_history),form);
  1117. }
  1118.  
  1119. LispObject input_history_replace(LispObject sym)
  1120. {
  1121.   int index;
  1122.  
  1123.   index = history_index(SYSTEM_GLOBAL_VALUE(input_history),sym,"!");
  1124.  
  1125.   if (index < 0) return(sym);
  1126.  
  1127.   return(get_history_value(SYSTEM_GLOBAL_VALUE(input_history),index));
  1128. }
  1129.   
  1130. void add_value_history_value(LispObject form)
  1131. {
  1132.   add_history_value(SYSTEM_GLOBAL_VALUE(value_history),form);
  1133. }
  1134.  
  1135. LispObject value_history_replace(LispObject sym)
  1136. {
  1137.   int index;
  1138.  
  1139.   index = history_index(SYSTEM_GLOBAL_VALUE(value_history),sym,"!!");
  1140.  
  1141.   if (index < 0) return(sym);
  1142.  
  1143.   return(get_history_value(SYSTEM_GLOBAL_VALUE(value_history),index));
  1144. }
  1145.  
  1146. LispObject replace_with_history_value(LispObject sym)
  1147. {
  1148.   return(value_history_replace(input_history_replace(sym)));
  1149. }
  1150.  
  1151. static void initialise_histories()
  1152. {
  1153.   SYSTEM_INITIALISE_GLOBAL(History *,input_history,
  1154.                (History *) system_static_malloc(sizeof(History)));
  1155.   SYSTEM_INITIALISE_GLOBAL(History *,value_history,
  1156.                (History *) system_static_malloc(sizeof(History)));
  1157.  
  1158.   initialise_history(SYSTEM_GLOBAL_VALUE(input_history));
  1159.   initialise_history(SYSTEM_GLOBAL_VALUE(value_history));
  1160.  
  1161. }
  1162.  
  1163. int get_history_count()
  1164. {
  1165.   return(SYSTEM_GLOBAL_VALUE(input_history)->count);
  1166. }
  1167.  
  1168. #else /* KJP */
  1169.  
  1170. /* Old hacked histories */
  1171.  
  1172. static SYSTEM_GLOBAL(LispObject,history_list);
  1173. static SYSTEM_GLOBAL(int,history_list_length);
  1174. static SYSTEM_GLOBAL(int,history_count);
  1175.  
  1176. int get_history_count()
  1177. {
  1178.   return(SYSTEM_GLOBAL_VALUE(history_count));
  1179. }
  1180.  
  1181. LispObject get_history_form(LispObject obj)
  1182. {
  1183.   LispObject walker;
  1184.   int i,n,pos;
  1185.  
  1186.   if (!is_symbol(obj)) return(obj);
  1187.   if (obj->SYMBOL.pname[0] != '!') return(obj);
  1188.  
  1189.   i = 1;
  1190.   while(obj->SYMBOL.pname[i] != '\0') {
  1191.     if (!isdigit(obj->SYMBOL.pname[i])) return(obj);
  1192.     ++i;
  1193.   }
  1194.  
  1195.   sscanf(&(obj->SYMBOL.pname[1]),"%d",&n);
  1196.  
  1197.   if (n > SYSTEM_GLOBAL_VALUE(history_count)) return(nil);
  1198.  
  1199.   pos = SYSTEM_GLOBAL_VALUE(history_list_length) - n - 1;
  1200.  
  1201.   for (walker = SYSTEM_GLOBAL_VALUE(history_list),i = 0; 
  1202.        i < pos;
  1203.        ++i, walker = CDR(walker));
  1204.  
  1205.   return(CAR(walker));
  1206. }
  1207.  
  1208. void put_history_form(LispObject *stacktop, LispObject form)
  1209. {
  1210.   ++SYSTEM_GLOBAL_VALUE(history_count);
  1211.   ++SYSTEM_GLOBAL_VALUE(history_list_length);
  1212.   EUCALLSET_2(SYSTEM_GLOBAL_VALUE(history_list), Fn_cons,
  1213.           form,SYSTEM_GLOBAL_VALUE(history_list));
  1214. }
  1215.  
  1216. void start_history()
  1217. {
  1218.   SYSTEM_INITIALISE_GLOBAL(LispObject,history_list,nil);
  1219.   SYSTEM_INITIALISE_GLOBAL(int,history_list_length,0);
  1220.   SYSTEM_INITIALISE_GLOBAL(int,history_count,0);
  1221.  
  1222.   ADD_SYSTEM_GLOBAL_ROOT(history_list);
  1223. }
  1224.  
  1225. #endif /* KJP */
  1226.  
  1227. #ifdef KJP
  1228.  
  1229. /*
  1230.  ** Noddy input processing 
  1231.  */
  1232.  
  1233. static LispObject sym_pling_root;
  1234. static LispObject sym_pling_exit;
  1235. static LispObject sym_pling_b;
  1236. static LispObject sym_pling_backtrace;
  1237. static LispObject sym_pling_q;
  1238. static LispObject sym_pling_quickie;
  1239. static LispObject sym_pling_c;
  1240. static LispObject sym_pling_commands;
  1241. static LispObject sym_pling_v;
  1242. static LispObject sym_pling_values;
  1243.  
  1244. LispObject process_input_form(LispObject form)
  1245. {
  1246.   
  1247.   add_input_history_value(form);
  1248.  
  1249.   /* We only know about magic symbols */
  1250.  
  1251.   if (!is_symbol(form)) return(form);
  1252.  
  1253.   /* Special symbols... */
  1254.  
  1255.   /* !root */
  1256.  
  1257.   if (form == sym_pling_root) {
  1258.     SYSTEM_GLOBAL_VALUE(current_interactive_module) =
  1259.       get_module(stacktop,sym_root);
  1260.     return(nil);
  1261.   }
  1262.  
  1263.   /* EOF or !exit */
  1264.  
  1265.   if (form == q_eof || form == sym_pling_exit) return(NULL);
  1266.  
  1267.   /* !b or !backtrace */
  1268.  
  1269.   if (form == sym_pling_b || form == sym_pling_backtrace) {
  1270.  
  1271.     module_eval_backtrace();
  1272.     return(nil);
  1273.  
  1274.   }
  1275.  
  1276.   /* !q or !quickie */
  1277.  
  1278.   if (form == sym_pling_q || form == sym_pling_quickie) {
  1279.  
  1280.     quickie_module_eval_backtrace();
  1281.     return(nil);
  1282.  
  1283.   }
  1284.  
  1285.   /* !c or !commands */
  1286.  
  1287.   if (form == sym_pling_c || form == sym_pling_commands) {
  1288.  
  1289.     show_history(SYSTEM_GLOBAL_VALUE(input_history));
  1290.     return(nil);
  1291.  
  1292.   }
  1293.  
  1294.   /* !v or !values */
  1295.  
  1296.   if (form == sym_pling_v || form == sym_pling_values) {
  1297.  
  1298.     show_history(SYSTEM_GLOBAL_VALUE(value_history));
  1299.     return(nil);
  1300.  
  1301.   }
  1302.  
  1303.   /* We know nothing! */
  1304.  
  1305.   return(form);
  1306.  
  1307. }
  1308.  
  1309. LispObject process_result_form(LispObject form)
  1310. {
  1311.   add_value_history_value(form);
  1312.   return(form);
  1313. }
  1314.  
  1315. void initialise_input_processing()
  1316. {
  1317.   initialise_histories();
  1318.  
  1319.   sym_pling_root = get_symbol(stacktop,"!root");
  1320.   sym_pling_exit = get_symbol(stacktop,"!exit");
  1321.   sym_pling_b = get_symbol(stacktop,"!b");
  1322.   sym_pling_backtrace = get_symbol(stacktop,"!backtrace");
  1323.   sym_pling_q = get_symbol(stacktop,"!q");
  1324.   sym_pling_quickie = get_symbol(stacktop,"!quickie");
  1325.   sym_pling_c = get_symbol(stacktop,"!c");
  1326.   sym_pling_commands = get_symbol(stacktop,"!commands");
  1327.   sym_pling_v = get_symbol(stacktop,"!v");
  1328.   sym_pling_values = get_symbol(stacktop,"!values");
  1329. }
  1330.  
  1331. #endif /* KJP */
  1332.  
  1333.  
  1334.